 (*$S+*)
 PROGRAM CODESTAT;

 {========================================================}
 {                                                        }
 {        UCSD     P-CODE     DISASSEMBLER                }
 {                                                        }
 {        Release level:      I.5    Sept, 1978           }
 {                                                        }
 {        Written by     William  P.  Franks              }
 {                                                        }
 {        Institute for Information Systems               }
 {        UC  San Diego,  La Jolla,  Ca                   }
 {                                                        }
 {        Kenneth  L.  Bowles,  Director                  }
 {                                                        }
 {        COPYRIGHT  (C)  1978,  Regents of the           }
 {        University of California,  San Diego            }
 {                                                        }
 {========================================================}

 CONST   MAXPROCNUM=150;

 TYPE    NMENONIC=PACKED ARRAY[0..7] OF CHAR;
         BYTETYPE=ARRAY[0..7] OF INTEGER;
         WORDTYPE=ARRAY[0..15] OF INTEGER;
         BYTE=0..255;
         OPTYPE=(SHORT,ONE,OPT,TWO,LOPT,WORDS,CHRS,BLK,CMPRSS,CMPRSS2,WORD);
         OPREC=RECORD CASE OPTYPE OF
                  SHORT:(TOTAL0:INTEGER);
           ONE,CHRS,BLK:(TOTAL1:INTEGER;
                         BYTEONE1:BYTETYPE);
                    TWO:(TOTAL2:INTEGER;
                         BYTEONE2:BYTETYPE;
                         BYTETWO2:BYTETYPE;
                         FLAVOR2:ARRAY[2..29] OF INTEGER);
               WORD,OPT:(TOTAL3:INTEGER;
                         PARMONE3:WORDTYPE);
                   LOPT:(TOTAL4:INTEGER;
                         BYTEONE4:BYTETYPE;
                         PARMTWO4:WORDTYPE);
                  WORDS:(TOTAL5:INTEGER;
                         PARMONE5:WORDTYPE;
                         PARMTWO5:WORDTYPE;
                         PARMTHREE5:WORDTYPE);
                 CMPRSS:(TOTAL6:INTEGER;
                         FLAVOR6:ARRAY[0..40] OF INTEGER);
                CMPRSS2:(TOTAL7:INTEGER;
                         FLAVOR7:ARRAY[1..6] OF INTEGER)
           END;
         OPPTR=^OPREC;
         OPFACTS=RECORD
           NAMES:ARRAY[52..255] OF NMENONIC;
           RECTYPES:ARRAY[0..255] OF OPTYPE
         END;
         JUMPREC=RECORD
           POS,NEG:WORDTYPE
         END;
         PRCLARRY=ARRAY[0..MAXPROCNUM] OF INTEGER;
         DSPTR=^DSARRY;
         DSARRY=ARRAY[0..1] OF INTEGER;
         HEXTYPE=PACKED RECORD CASE INTEGER OF
             0:(DUM2,DUM1,HI,LO:0..15);
             1:(HIBYTE,LOWBYTE:0..255);
             2:(WORD:INTEGER)
           END;

 VAR     DISPLAY:BOOLEAN;
         CH,CR:CHAR;
         PCTMAX,MAXOP,INUM,BYTESIZE,BYTEPOS,OP,BUFSTART,PROCNUM,SEGNUM:INTEGER;
         BITE:BYTE;
         DSSTART:DSPTR;
         SWAP,CONTROL,CONSOLE,DONEPROC,LEXCHECK,DATAWATCH,
         LEXLOOK   :BOOLEAN;
         HEXCOUNT,MAXPROC,SEGSTBLK,BUFSTBLK,OPTOTAL,
         SEGSIZE,OFFSET,BACKJUMP,SLDC,
         SLDL,SLDO,SIND,PROCSTART,DATASEG,DATAPROC,
         DATASEGSIZE,LEXLEVEL,DATAREF,DTSGSZ,JUMPTOTAL   :INTEGER;
         HEX:HEXTYPE;
         RNUM:REAL;
         OPCODE:ARRAY[0..255] OF OPPTR;
         LISTFILE:INTERACTIVE;
         HEXCHAR,CODE   :PACKED ARRAY[0..15] OF CHAR;
         INPUTFILE:FILE;
         JUMPSTATS:JUMPREC;
         SEGLEX:ARRAY[0..15] OF INTEGER;
         SEGDIREC:PACKED ARRAY[0..511] OF BYTE;
         NAMES:ARRAY[52..255] OF NMENONIC;
         RECTYPES:PACKED ARRAY[0..255] OF OPTYPE;
         PROCS:ARRAY [0..MAXPROCNUM] OF INTEGER;
         PROCCALL:ARRAY[0..15] OF ^PRCLARRY;
         JUMPS,PROCLEX:ARRAY[0..99] OF INTEGER;
         LASTFILENAME:STRING;
         BUFFER:PACKED ARRAY[0..2559] OF BYTE;

 SEGMENT PROCEDURE INIT;
 VAR   I:INTEGER;
       FILENAME:STRING;
       OPFILE:FILE OF OPFACTS;

 PROCEDURE NEWOP(FLAVOR:OPTYPE);
 BEGIN
   CASE FLAVOR OF
         SHORT:NEW(OPCODE[I],SHORT);
           ONE:NEW(OPCODE[I],ONE);
           BLK:NEW(OPCODE[I],BLK);
          CHRS:NEW(OPCODE[I],CHRS);
           OPT:NEW(OPCODE[I],OPT);
           TWO:NEW(OPCODE[I],TWO);
          LOPT:NEW(OPCODE[I],LOPT);
         WORDS:NEW(OPCODE[I],WORDS);
        CMPRSS:NEW(OPCODE[I],CMPRSS);
       CMPRSS2:NEW(OPCODE[I],CMPRSS2);
          WORD:NEW(OPCODE[I],WORD)
     END;
   WITH OPCODE[I]^ DO
     CASE FLAVOR OF
              SHORT:TOTAL0:=0;
       CHRS,BLK,ONE:BEGIN
                      TOTAL1:=0;
                      FILLCHAR(BYTEONE1,16,0);
                    END;
                TWO:BEGIN
                      TOTAL2:=0;
                      FILLCHAR(BYTEONE2,16,0);
                      FILLCHAR(BYTETWO2,16,0);
                      FILLCHAR(FLAVOR2,56,0);
                    END;
           WORD,OPT:BEGIN
                      TOTAL3:=0;
                      FILLCHAR(PARMONE3,32,0);
                    END;
               LOPT:BEGIN
                      TOTAL4:=0;
                      FILLCHAR(BYTEONE4,16,0);
                      FILLCHAR(PARMTWO4,32,0);
                    END;
              WORDS:BEGIN
                      TOTAL5:=0;
                      FILLCHAR(PARMONE5,32,0);
                      FILLCHAR(PARMTWO5,32,0);
                      FILLCHAR(PARMTHREE5,32,0);
                    END;
             CMPRSS:BEGIN
                      TOTAL6:=0;
                      FILLCHAR(FLAVOR6,82,0);
                    END;
            CMPRSS2:BEGIN
                      TOTAL7:=0;
                      FILLCHAR(FLAVOR7,12,0);
                    END
     END;
 END;

 BEGIN(* INIT *)
   CR:=CHR(13);
   RESET(OPFILE,'*OPCODES.I5');
   NAMES:=OPFILE^.NAMES;
   FOR I:=0 TO 255 DO
     BEGIN
       NEWOP(OPFILE^.RECTYPES[I]);
       RECTYPES[I]:=OPFILE^.RECTYPES[I];
     END;
   CLOSE(OPFILE);
   PAGE(OUTPUT);
   GOTOXY(22,10);
   WRITELN('UCSD   P-CODE   DISASSEMBLER');
   GOTOXY(0,0);
   WRITE('Input code file: ');
   READLN(FILENAME);
   (*$I-*)
   OPENOLD(INPUTFILE,CONCAT(FILENAME,'.CODE'));
   (*$I+*)
   IF IORESULT <> 0 THEN
      OPENOLD(INPUTFILE,FILENAME);
   IF BLOCKREAD(INPUTFILE,SEGDIREC,1)=1  THEN ;
   FOR SEGNUM:=0 TO 15 DO
     IF SEGDIREC[SEGNUM*4] + SEGDIREC[SEGNUM*4 + 1]<>0 THEN
       BEGIN
         NEW(PROCCALL[SEGNUM]);
         FILLCHAR(PROCCALL[SEGNUM]^,SIZEOF(PRCLARRY),0);
       END
     ELSE PROCCALL[SEGNUM]:=NIL;
   PAGE(OUTPUT);
   GOTOXY(0,10);
   WRITELN(' ':10,'Is this code file designed for a machine');
   WRITE(' ':7,'where byte zero is the most significant byte <terak no>?');
   READ(KEYBOARD,CH);
   SWAP:=(CH='Y');
   PAGE(OUTPUT);
   GOTOXY(0,10);
   WRITE('Dis-assembly output file (<CR> for none): ');
   READLN(FILENAME);
   LASTFILENAME:=FILENAME;
   DISPLAY:=(FILENAME<>'');
   CONSOLE:=(FILENAME='CONSOLE:') OR (FILENAME='#1:');
   IF DISPLAY THEN REWRITE(LISTFILE,FILENAME);
   SEGNUM:=0;
   OPTOTAL:=0;
   SLDC:=0;
   SLDL:=0;
   SLDO:=0;
   SIND:=0;
   JUMPTOTAL:=0;
   HEXCOUNT:=0;
   CODE:='                ';
   HEXCHAR:='0123456789ABCDEF';
   FILLCHAR(JUMPSTATS.POS,32,0);
   FILLCHAR(JUMPSTATS.NEG,32,0);
   LEXLOOK:=FALSE;
 END;

 PROCEDURE PROMPT; FORWARD;

 SEGMENT PROCEDURE DISASSEMBLE;

 FUNCTION BUFRESET(BYTEPOS,OFFSET,DIRECTION:INTEGER):INTEGER;
 VAR   NEWBYTE:INTEGER;
 BEGIN
   NEWBYTE:=BYTEPOS + OFFSET;
   REPEAT
     BUFSTBLK:=BUFSTBLK + DIRECTION;
     BUFSTART:=(BUFSTBLK - SEGSTBLK)*512;
   UNTIL (NEWBYTE - BUFSTART>=0) AND (NEWBYTE - BUFSTART<2557);
   IF BLOCKREAD(INPUTFILE,BUFFER,5,BUFSTBLK)=1 THEN;
   BUFRESET:=NEWBYTE - BUFSTART;
 END;

 FUNCTION LASTBYTE:BYTE;
 VAR   CHANGE:INTEGER;
 BEGIN
   IF BYTEPOS<1 THEN
     BEGIN
       BYTEPOS:=BUFRESET(BUFSTART + BYTEPOS,-1,-1);
       OFFSET:=OFFSET - 1;
     END
   ELSE
     BEGIN
       BYTEPOS:=BYTEPOS - 1;
       OFFSET:=OFFSET - 1;
     END;
   LASTBYTE:=BUFFER[BYTEPOS];
 END;

 FUNCTION GETBYTE:BYTE;
 VAR  HEX:HEXTYPE;
 BEGIN
   IF BYTEPOS>2559 THEN
     BYTEPOS:=BUFRESET(BUFSTART + BYTEPOS,0,5);
   GETBYTE:=BUFFER[BYTEPOS];
   IF HEXCOUNT<15 THEN
     BEGIN
       HEX.LOWBYTE:=BUFFER[BYTEPOS];
       CODE[HEXCOUNT]:=HEXCHAR[HEX.HI];
       CODE[HEXCOUNT + 1]:=HEXCHAR[HEX.LO];
       HEXCOUNT:=HEXCOUNT + 2;
     END;
   BYTEPOS:=BYTEPOS + 1;
 END;

 FUNCTION GETBIG:INTEGER;
 VAR  BIG:HEXTYPE;
      FIRSTBYTE:BYTE;
 BEGIN
   FIRSTBYTE:=GETBYTE;
   IF FIRSTBYTE>127 THEN
     BEGIN
       BIG.LOWBYTE:=GETBYTE;
       BIG.HIBYTE:=FIRSTBYTE - 128;
       GETBIG:=BIG.WORD;
     END
   ELSE GETBIG:=FIRSTBYTE;
 END;

 FUNCTION GETWORD:INTEGER;
 VAR  WERD:HEXTYPE;
 BEGIN
   IF SWAP THEN
     BEGIN
       WERD.HIBYTE:=GETBYTE;
       WERD.LOWBYTE:=GETBYTE;
     END
   ELSE
     BEGIN
       WERD.LOWBYTE:=GETBYTE;
       WERD.HIBYTE:=GETBYTE;
     END;
   GETWORD:=WERD.WORD;
 END;

 FUNCTION MOSTSIGBIT(OPERAND:INTEGER):INTEGER;
 VAR  BYTESIZE:INTEGER;
 BEGIN
   IF OPERAND<0 THEN
     MOSTSIGBIT:=15
   ELSE
     BEGIN
       BYTESIZE:=-1;
       REPEAT
         BYTESIZE:=BYTESIZE + 1;
         OPERAND:=OPERAND DIV 2;
       UNTIL OPERAND=0;
       MOSTSIGBIT:=BYTESIZE;
     END;
 END;

 PROCEDURE ACTACCESS(FINALEX,OFFSET:INTEGER); FORWARD;

 PROCEDURE SHORTOP;
 {SLDC ABI  ABR  ADI  ADR  LAND DIF  DVI  DVR  CHK  FLO  FLT  INN  INT
  LOR  MODI MPI  MPR  NGI  NGR  LNOT SRS  SBI  SBR  SGS  SQI  SQR  STO
  IXS  UNI  S2P  LDCN LDP  STP  LDB  STB  EQUI GEQI GTRI LEQI LESI NEQI
  S1P  IXB  BYT  XIT  SLDL SLDO SIND}

 BEGIN
   OPCODE[BITE]^.TOTAL0:=OPCODE[BITE]^.TOTAL0 + 1;
   IF BITE=214 THEN DONEPROC:=TRUE;
   IF BITE<128 THEN
     BEGIN
       SLDC:=SLDC + 1;
       IF DISPLAY THEN WRITELN(LISTFILE,NAMES[127],BITE:6,' ':18,CODE);
     END
   ELSE
     BEGIN
       IF DISPLAY THEN WRITE(LISTFILE,NAMES[BITE]);
       IF BITE>215 THEN
         IF BITE<232 THEN
           BEGIN
             SLDL:=SLDL + 1;
             IF DATAWATCH THEN ACTACCESS(LEXLEVEL,BITE - 215);
             IF DISPLAY THEN WRITELN(LISTFILE,BITE-215:6,' ':18,CODE);
           END
         ELSE IF BITE<248 THEN
           BEGIN
             SLDO:=SLDO + 1;
             IF DATAWATCH THEN ACTACCESS(0,BITE - 231);
             IF DISPLAY THEN WRITELN(LISTFILE,BITE-231:6,' ':18,CODE);
           END
         ELSE
           BEGIN
             SIND:=SIND + 1;
             IF DISPLAY THEN WRITELN(LISTFILE,BITE-248:6,' ':18,CODE);
           END
       ELSE
         IF DISPLAY THEN WRITELN(LISTFILE,' ':24,CODE);
     END;
   IF DONEPROC THEN
     IF DISPLAY THEN WRITELN(LISTFILE);
 END;

 PROCEDURE ONEOP;
 {ADJ  FJP  SAS  RNP  CIP  UJP  LDM  STM  RBP  CBP  CLP  CGP  EFJ  NFJ}

 VAR   JUMPSIZE:INTEGER;
       PCALL:BOOLEAN;

 PROCEDURE JUMPOPST;
 VAR   NEG:BOOLEAN;
 BEGIN
   NEG:=(JUMPSIZE<0);
   IF NEG THEN JUMPSIZE:=-JUMPSIZE;
   BYTESIZE:=-1;
   REPEAT
     BYTESIZE:=BYTESIZE + 1;
     JUMPSIZE:=JUMPSIZE DIV 2;
   UNTIL JUMPSIZE=0;
   IF NEG THEN
     JUMPSTATS.NEG[BYTESIZE]:=JUMPSTATS.NEG[BYTESIZE] + 1
   ELSE
     JUMPSTATS.POS[BYTESIZE]:=JUMPSTATS.POS[BYTESIZE] + 1;
 END;

 BEGIN(* ONEOP *)
   WITH OPCODE[BITE]^ DO
     BEGIN
       TOTAL1:=TOTAL1 + 1;
       IF DISPLAY THEN WRITE(LISTFILE,NAMES[BITE]);
       IF (BITE=173) OR (BITE=193) THEN DONEPROC:=TRUE;
       IF (BITE IN [161,185,211,212]) THEN
         BEGIN
           BITE:=GETBYTE;
           IF BITE<128 THEN
             BEGIN
               JUMPTOTAL:=JUMPTOTAL + 1;
               JUMPSIZE:=BITE;
               JUMPOPST;
               IF DISPLAY THEN WRITELN(LISTFILE,
                     BUFSTART + BYTEPOS + BITE - PROCSTART:6,' ':18,CODE);
             END
           ELSE
             BEGIN
               JUMPTOTAL:=JUMPTOTAL + 1;
               JUMPSIZE:=JUMPS[(256-BITE-8)DIV 2] - (BUFSTART+BYTEPOS-PROCSTART);
               JUMPOPST;
               IF DISPLAY THEN WRITELN(LISTFILE,
                              JUMPS[(256 - BITE - 8) DIV 2]:6,' ':18,CODE);
             END;
         END
       ELSE
         BEGIN
           PCALL:=(BITE IN [174,206,207]);
           BITE:=GETBYTE;
           IF PCALL THEN
             PROCCALL[SEGNUM]^[BITE]:=PROCCALL[SEGNUM]^[BITE] + 1;
           IF DISPLAY THEN WRITELN(LISTFILE,BITE:6,' ':18,CODE);
           IF DONEPROC THEN
             IF DISPLAY THEN WRITELN(LISTFILE);
         END;
       BYTESIZE:=MOSTSIGBIT(BITE);
       BYTEONE1[BYTESIZE]:=BYTEONE1[BYTESIZE] + 1;
     END;
 END;

 PROCEDURE OPTOP;
 {INC  IND  IXA  LAO  LDO  MOV  MVB  SRO  LLA  LDL  STL  BTP}
 VAR   BIG:INTEGER;
       LOCAL,GLOBAL:BOOLEAN;
 BEGIN
   WITH OPCODE[BITE]^ DO
     BEGIN
       TOTAL3:=TOTAL3 + 1;
       IF DATAWATCH THEN
         BEGIN
           LOCAL:=(BITE IN [198,202,204]);
           GLOBAL:=(BITE IN [165,167,171]);
         END;
       IF DISPLAY THEN WRITE(LISTFILE,NAMES[BITE]);
       BIG:=GETBIG;
       BYTESIZE:=MOSTSIGBIT(BIG);
       PARMONE3[BYTESIZE]:=PARMONE3[BYTESIZE] + 1;
       IF DATAWATCH THEN
         IF LOCAL THEN ACTACCESS(LEXLEVEL,BIG)
         ELSE IF GLOBAL THEN ACTACCESS(0,BIG);
       IF DISPLAY THEN WRITELN(LISTFILE,BIG:6,' ':18,CODE);
     END;
 END;

 PROCEDURE LOPTOP;
 {LDA  LOD  STR}
 VAR   BIG,LINKS:INTEGER;
 BEGIN
   WITH OPCODE[BITE]^ DO
     BEGIN
       TOTAL4:=TOTAL4 + 1;
       IF DISPLAY THEN WRITE(LISTFILE,NAMES[BITE]);
       BITE:=GETBYTE;
       IF DISPLAY THEN WRITE(LISTFILE,BITE:6);
       LINKS:=BITE;
       BYTESIZE:=MOSTSIGBIT(BITE);
       BYTEONE4[BYTESIZE]:=BYTEONE4[BYTESIZE] + 1;
       BIG:=GETBIG;
       BYTESIZE:=MOSTSIGBIT(BIG);
       PARMTWO4[BYTESIZE]:=PARMTWO4[BYTESIZE] + 1;
       IF DATAWATCH THEN ACTACCESS(LEXLEVEL - LINKS,BIG);
       IF DISPLAY THEN WRITELN(LISTFILE,BIG:6,' ':12,CODE);
     END;
 END;

 PROCEDURE TWOOP;
 {IXP  CXP}
 VAR   BYTEONE,BYTETWO:BYTE;
       EXTPR:BOOLEAN;
 BEGIN
   WITH OPCODE[BITE]^ DO
     BEGIN
       TOTAL2:=TOTAL2+ 1;
       IF DISPLAY THEN WRITE(LISTFILE,NAMES[BITE]);
       IF BITE=205 THEN EXTPR:=TRUE ELSE EXTPR:=FALSE;
       BYTEONE:=GETBYTE;
       BYTESIZE:=MOSTSIGBIT(BYTEONE);
       BYTEONE2[BYTESIZE]:=BYTEONE2[BYTESIZE] + 1;
       BYTETWO:=GETBYTE;
       DONEPROC:=(EXTPR) AND (BYTEONE=0) AND (BYTETWO=2);
       IF (EXTPR) AND (BYTEONE=0) AND (BYTETWO>1) AND (BYTETWO<30) THEN
         BEGIN
           FLAVOR2[BYTETWO]:=FLAVOR2[BYTETWO] + 1;
           IF DISPLAY THEN WRITELN(LISTFILE,NAMES[56 + BYTETWO],' ':16,CODE);
         END
       ELSE
         BEGIN
           IF EXTPR THEN
             PROCCALL[BYTEONE]^[BYTETWO]:=PROCCALL[BYTEONE]^[BYTETWO] + 1;
           IF DISPLAY THEN WRITELN(LISTFILE,BYTEONE:6,BYTETWO:6,' ':12,CODE);
         END;
       BYTESIZE:=MOSTSIGBIT(BYTETWO);
       BYTETWO2[BYTESIZE]:=BYTETWO2[BYTESIZE] + 1;
     END;
 END;


 PROCEDURE WORDOP;
 {  LCI  }
 VAR   WERD:INTEGER;
 BEGIN
   WITH OPCODE[BITE]^ DO
     BEGIN
       TOTAL3:=TOTAL3+ 1;
       IF DISPLAY THEN WRITE(LISTFILE,NAMES[BITE]);
       WERD:=GETWORD;
       IF DISPLAY THEN WRITELN(LISTFILE,WERD:6,' ':18,CODE);
       BYTESIZE:=MOSTSIGBIT(WERD);
       PARMONE3[BYTESIZE]:=PARMONE3[BYTESIZE] + 1;
     END;
 END;

 PROCEDURE WORDSOP;
 {  XJP  }
 VAR   WORD1,WORD2,WORD3:INTEGER;
 BEGIN
   WITH OPCODE[BITE]^ DO
     BEGIN
       TOTAL5:=TOTAL5 + 1;
       IF DISPLAY THEN WRITE(LISTFILE,NAMES[BITE]);
       IF ODD(BYTEPOS) THEN BITE:=GETBYTE;
       WORD1:=GETWORD;
       BYTESIZE:=MOSTSIGBIT(WORD1);
       PARMONE5[BYTESIZE]:=PARMONE5[BYTESIZE] + 1;
       WORD2:=GETWORD;
       BYTESIZE:=MOSTSIGBIT(WORD2);
       PARMTWO5[BYTESIZE]:=PARMTWO5[BYTESIZE] + 1;
       BYTESIZE:=MOSTSIGBIT(WORD2-WORD1+1);
       PARMTHREE5[BYTESIZE]:=PARMTHREE5[BYTESIZE] + 1;
       BITE:=GETBYTE;   BITE:=GETBYTE;
       IF BITE<128 THEN
         WORD3:=BUFSTART + BYTEPOS + BITE - PROCSTART
       ELSE
         WORD3:=JUMPS[(256 - BITE - 8) DIV 2];
       IF DISPLAY THEN WRITELN(LISTFILE,WORD1:6,WORD2:6,WORD3:6,' ':6,CODE);
       WORD2:=WORD2 - WORD1 + 1;
       FOR WORD1:=1 TO WORD2 DO
         BEGIN
           HEXCOUNT:=0;
           CODE:='                ';
           WORD3:=GETWORD;
           WORD3:=BUFSTART + BYTEPOS - WORD3 - 2 - PROCSTART;
           IF DISPLAY THEN WRITELN(LISTFILE,WORD3:41,' ':18,CODE);
         END;
     END;
 END;

 PROCEDURE CMPRSSOP;
 {  CSP  }
 BEGIN
   WITH OPCODE[BITE]^ DO
     BEGIN
       TOTAL6:=TOTAL6 + 1;
       IF DISPLAY THEN WRITE(LISTFILE,NAMES[BITE]);
       BITE:=GETBYTE;
       IF DISPLAY THEN WRITELN(LISTFILE,NAMES[86 + BITE],' ':16,CODE);
       FLAVOR6[BITE]:=FLAVOR6[BITE] + 1;
     END;
 END;


 PROCEDURE CMPRSS2OP;
 {EQU  GEQ  GTR  LEQ  LES  NEQ}
 VAR   BIG:INTEGER;
 BEGIN
   WITH OPCODE[BITE]^ DO
     BEGIN
       TOTAL7:=TOTAL7 + 1;
       IF DISPLAY THEN WRITE(LISTFILE,NAMES[BITE]);
       BITE:=GETBYTE;
       FLAVOR7[BITE DIV 2]:=FLAVOR7[BITE DIV 2] +1;
       IF (BITE=10) OR (BITE=12) THEN BIG:=GETBIG;
       IF DISPLAY THEN
         CASE BITE OF
            2:WRITELN(LISTFILE,'REAL',' ':20,CODE);
            4:WRITELN(LISTFILE,'STR ',' ':20,CODE);
            6:WRITELN(LISTFILE,'BOOL',' ':20,CODE);
            8:WRITELN(LISTFILE,'POWR',' ':20,CODE);
           10:WRITELN(LISTFILE,'BYTE',BIG:6,' ':14,CODE);
           12:WRITELN(LISTFILE,'WORD',BIG:6,' ':14,CODE)
         END;
     END;
 END;

 PROCEDURE CHRSOP;
 {  LCA  }
 VAR  SKIPOVER,I:INTEGER;
 BEGIN
   WITH OPCODE[BITE]^ DO
     BEGIN
       TOTAL1:=TOTAL1 + 1;
       IF DISPLAY THEN WRITE(LISTFILE,NAMES[BITE]);
       BITE:=GETBYTE;
       IF DISPLAY THEN WRITE(LISTFILE,BITE:6,'   ''');
       BYTESIZE:=MOSTSIGBIT(BITE);
       BYTEONE1[BYTESIZE]:=BYTEONE1[BYTESIZE] + 1;
       IF DISPLAY THEN
         FOR I:=1 TO BITE DO WRITE(LISTFILE,CHR(GETBYTE))
       ELSE
         FOR I:=1 TO BITE DO SKIPOVER:=GETBYTE;
       IF DISPLAY THEN WRITELN(LISTFILE,'''');
     END;
 END;


 PROCEDURE BLKOP;
 {  LDC  }
 VAR  WERD,I,SKIPOVER:INTEGER;
 BEGIN
   WITH OPCODE[BITE]^ DO
     BEGIN
       TOTAL1:=TOTAL1 + 1;
       IF DISPLAY THEN WRITE(LISTFILE,NAMES[BITE]);
       BITE:=GETBYTE;
       IF DISPLAY THEN WRITELN(LISTFILE,BITE:6,' ':18,CODE);
       BYTESIZE:=MOSTSIGBIT(BITE);
       BYTEONE1[BYTESIZE]:=BYTEONE1[BYTESIZE] + 1;
       IF ODD(BYTEPOS) THEN SKIPOVER:=GETBYTE;
       FOR I:=1 TO BITE DO
       BEGIN
         HEXCOUNT:=0;
         CODE:='                ';
         WERD:=GETWORD;
         IF DISPLAY THEN WRITELN(LISTFILE,WERD:41,' ':18,CODE);
       END;
     END;
 END;

 (* $I DISASM1.TEXT *)
                         {start of DISASM1.TEXT}
         {Copyright (c) Regents of University of California at San Diego}

 PROCEDURE PROCEJUR;
 VAR HEX:HEXTYPE;
     LINENUM,LPROCNUM:INTEGER;

 PROCEDURE JUMPINFO;
 VAR  OTHERBYTE:INTEGER;
 BEGIN
   BACKJUMP:=0; BYTEPOS:=BYTEPOS - 6; OFFSET:=OFFSET - 6;
   REPEAT
     BACKJUMP:=BACKJUMP + 1;
     OTHERBYTE:=LASTBYTE;
     BITE:=LASTBYTE;
     IF (SWAP) AND (BITE<128) THEN {jumps relative to start of segment}
       JUMPS[BACKJUMP]:=BUFSTART + BYTEPOS - BITE*256 - OTHERBYTE
     ELSE IF (NOT SWAP) THEN
       IF OTHERBYTE<128 THEN
         JUMPS[BACKJUMP]:=BUFSTART + BYTEPOS - BITE - OTHERBYTE*256
       ELSE BITE:=OTHERBYTE;
   UNTIL (BITE>127) OR (BACKJUMP=99);
   JUMPS[0]:=BACKJUMP - 1;
   IF BYTEPOS - OFFSET<0 THEN
       BYTEPOS:=BUFRESET(BUFSTART + BYTEPOS,-OFFSET,-1)
     ELSE
       BYTEPOS:=BYTEPOS - OFFSET;
   PROCSTART:=BUFSTART + BYTEPOS; {jumps now relative to start of procedure}
   FOR BACKJUMP:=1 TO JUMPS[0] DO JUMPS[BACKJUMP]:=JUMPS[BACKJUMP] - PROCSTART;
 END;

 BEGIN (*PROCEJUR*)
   IF PROCS[PROCNUM]=0 THEN
     WRITELN('Procedure not in file')
   ELSE
     BEGIN
       BYTEPOS:=SEGSIZE - BUFSTART - 2*(PROCNUM + 1) - PROCS[PROCNUM] - 2;
       IF BYTEPOS<0 THEN
         BYTEPOS:=BUFRESET(SEGSIZE - 2*(PROCNUM + 1),-PROCS[PROCNUM] - 2,-1)
       ELSE IF BYTEPOS>2556 THEN
         BYTEPOS:=BUFRESET(BUFSTART + BYTEPOS,0,1);
       OFFSET:=GETWORD;                  { pointer to ENTER IC }
       LPROCNUM:=GETBYTE;
       LEXLEVEL:=GETBYTE;
       BYTEPOS:=BYTEPOS - 4;
       IF LEXLEVEL=255 THEN LEXLEVEL:=-1;
       IF NOT (LEXCHECK OR LEXLOOK) THEN
         IF LPROCNUM=0 THEN
           WRITELN('Procedure ',PROCNUM:3,' is written in Assembly.')
         ELSE
         BEGIN
           JUMPINFO;
           DONEPROC:=FALSE;
           IF DISPLAY THEN WRITELN(LISTFILE,
                 ' ':10,'BLOCK #',BYTEPOS DIV 512 + BUFSTBLK:3,
                 '     OFFSET IN BLOCK=',BYTEPOS MOD 512:3,CR,
                 'SEGMENT PROC     OFFSET#',' ':35,'HEX CODE')
             ELSE IF NOT CONTROL THEN
               BEGIN
                 WRITE('.');
                 IF PROCNUM=50 THEN WRITE(CR,'    ');
               END
             ELSE WRITE(CR,'[',PROCNUM:2,']');
           LINENUM:=0;
           REPEAT
             HEX.WORD:=BUFSTART + BYTEPOS - PROCSTART;
             IF DISPLAY THEN WRITE(LISTFILE,SEGNUM:7,PROCNUM:5,HEX.WORD:6,'(',
                 HEXCHAR[HEX.DUM1],HEXCHAR[HEX.HI],HEXCHAR[HEX.LO],'):   ');
             IF CONTROL AND NOT CONSOLE THEN
               BEGIN
                 WRITE('.');
                 LINENUM:=LINENUM + 1;
                 IF (LINENUM MOD 50=0) THEN WRITE(CR,'    ');
               END;
             HEXCOUNT:=0;
             CODE:='                ';
             BITE:=GETBYTE;
             OPTOTAL:=OPTOTAL + 1;
             CASE RECTYPES[BITE] OF
                     SHORT:SHORTOP;
                    CMPRSS:CMPRSSOP;
                   CMPRSS2:CMPRSS2OP;
                       ONE:ONEOP;
                      CHRS:CHRSOP;
                       BLK:BLKOP;
                       OPT:OPTOP;
                      LOPT:LOPTOP;
                       TWO:TWOOP;
                     WORDS:WORDSOP;
                      WORD:WORDOP
               END;
           UNTIL DONEPROC;
         END;
     END;
 END;

 PROCEDURE ALLPROCS;
 VAR I,J,MAXDIST,INDEX:INTEGER;
     SORTNUMS:ARRAY[0..MAXPROCNUM] OF INTEGER;
     SORTPROCS:ARRAY[0..MAXPROCNUM] OF BYTE;
 BEGIN
   IF DISPLAY THEN
     BEGIN
       SORTNUMS:=PROCS;
       FOR I:=1 TO MAXPROCNUM DO SORTPROCS[I]:=I;
       FOR I:=1 TO PROCS[0] DO
         BEGIN
           MAXDIST:=0;
           INDEX:=0;
           FOR J:=I TO PROCS[0] DO
             IF SORTNUMS[J]>=MAXDIST THEN
               BEGIN
                 MAXDIST:=SORTNUMS[J];
                 INDEX:=J;
               END;
           SORTNUMS[INDEX]:=SORTNUMS[I];
           SORTNUMS[I]:=SORTPROCS[INDEX];
           SORTPROCS[INDEX]:=SORTPROCS[I];
         END;
       FOR I:=1 TO PROCS[0] DO
         BEGIN
           PROCNUM:=SORTNUMS[I];
           PROCEJUR;
         END;
     END
   ELSE FOR PROCNUM:=1 TO PROCS[0] DO PROCEJUR;
 END;

 PROCEDURE SEGMINT;
 BEGIN
   IF SWAP THEN
     BEGIN
       SEGSTBLK:=SEGDIREC[SEGNUM*4 + 1];
       SEGSIZE:=SEGDIREC[SEGNUM*4 + 3] + SEGDIREC[SEGNUM*4 + 2]*256;
     END
   ELSE
     BEGIN
       SEGSTBLK:=SEGDIREC[SEGNUM*4];
       SEGSIZE:=SEGDIREC[SEGNUM*4 + 3]*256 + SEGDIREC[SEGNUM*4 + 2];
     END;
   BUFSTBLK:=SEGSTBLK;
   IF SEGSIZE>2560 THEN
       BYTEPOS:=BUFRESET(SEGSIZE,-1,1)
     ELSE
       BYTEPOS:=BUFRESET(SEGSIZE,-1,0);
   PROCS[0]:=BUFFER[BYTEPOS];  (* number of procs in segment *)
   BYTEPOS:=BYTEPOS - 2*PROCS[0] - 1;
   FOR PROCNUM:=PROCS[0] DOWNTO 1 DO PROCS[PROCNUM]:=GETWORD;
   IF NOT (CONTROL OR LEXCHECK) THEN ALLPROCS;
 END;

 PROCEDURE ACTACCESS; {FINALEX,OFFSET:INTEGER;}
 VAR  FINALPROC,FINALSEG:INTEGER;
      INSIDE:BOOLEAN;
 BEGIN
   IF (FINALEX=PROCLEX[DATAPROC]) AND (PROCNUM>=DATAPROC) THEN
     IF SEGNUM=DATASEG THEN
       BEGIN
         INSIDE:=(PROCNUM=DATAPROC);
         FINALPROC:=PROCNUM;
         WHILE PROCLEX[FINALPROC]>PROCLEX[DATAPROC] DO FINALPROC:=FINALPROC - 1;
         IF FINALPROC=DATAPROC THEN
           {$R-}
           DSSTART^[OFFSET]:=DSSTART^[OFFSET] + 1;
           {$R+}
       END
     ELSE IF (DATAPROC=1) AND (SEGNUM>DATASEG) THEN
       BEGIN
         FINALSEG:=SEGNUM;
         WHILE SEGLEX[FINALSEG]>SEGLEX[DATASEG] DO FINALSEG:=FINALSEG - 1;
         IF FINALSEG=DATASEG THEN
           {$R-}
           DSSTART^[OFFSET]:=DSSTART^[OFFSET] + 1;
           {$R+}
       END;
 END;

 PROCEDURE PROCGUIDE;
 TYPE  SPACEPTR=^SPACE;
       SPACE=ARRAY[0..19] OF INTEGER;
 VAR   I,J:INTEGER;
       DSSPACE:SPACEPTR;

 PROCEDURE DATASEGINFO;
 VAR  TEMP:INTEGER;
 BEGIN
   PROCEJUR;
   BYTEPOS:=BYTEPOS - 2;
   IF SWAP THEN
     BEGIN
       DTSGSZ:=LASTBYTE;
       DTSGSZ:=DTSGSZ + LASTBYTE*256;
       TEMP:=LASTBYTE;
       DTSGSZ:=DTSGSZ + LASTBYTE*256 + TEMP;
     END
   ELSE
     BEGIN
       DTSGSZ:=LASTBYTE*256;
       DTSGSZ:=DTSGSZ + LASTBYTE;
       TEMP:=LASTBYTE*256;
       DTSGSZ:=DTSGSZ + LASTBYTE + TEMP;
     END;
   DTSGSZ:=DTSGSZ DIV 2;
 END;

 PROCEDURE PROCLOOK;
 BEGIN
   GOTOXY(0,3); WRITE(' ':50); GOTOXY(0,3);
   LEXLOOK:=TRUE;
   I:=(PROCS[0] DIV 5) + 1;
   FOR J:=0 TO ((PROCS[0]-1) DIV I) DO WRITE('    #  LL  SIZE');
   WRITELN;
   FOR PROCNUM:=1 TO PROCS[0] DO
     BEGIN
       DATASEGINFO;
       GOTOXY(15*((PROCNUM-1) DIV I),5+((PROCNUM-1) MOD I));
       WRITE(PROCNUM:5,':',LEXLEVEL:3,DTSGSZ:6);
     END;
   FOR J:=1 TO (5 - (PROCS[0] MOD 5)) DO WRITELN;
   PROMPT;
   LEXLOOK:=FALSE;
 END;

 BEGIN {PROCGUIDE}
   SEGMINT;
   REPEAT
     PAGE(OUTPUT);
     WRITE('Procedure guide:  #(of procedure),');
     IF LEXCHECK THEN
       WRITELN('L(isting),Q(uit)')
     ELSE
       WRITELN('A(ll),L(isting),Q(uit)');
     WRITE('  to segment: ');
     FOR I:=1 TO 8 DO WRITE(CHR(SEGDIREC[63 + SEGNUM*8 + I]));
     PROCNUM:=0;
     WRITE(CR,CR,'which procedure ');
     IF LEXCHECK THEN
       WRITE('data segment to watch?')
     ELSE
       WRITE('to dis-assemble?');
     READ(CH);
     IF (CH='L') THEN
         PROCLOOK
     ELSE IF (CH='A') AND (NOT LEXCHECK) THEN
       BEGIN
         PAGE(OUTPUT);
         WRITELN('dis-assembling all',PROCS[0]:3,' procedures',CR,CR);
         IF NOT DISPLAY THEN WRITE(CR,CR,'(',SEGNUM:2,')');
         ALLPROCS;
         PROMPT;
         CH:='Q';
       END
     ELSE IF (CH>='0') AND (CH<='9') THEN
       BEGIN
         PROCNUM:=ORD(CH)-ORD('0');
         READ(CH);
         IF (CH>='0') AND (CH<='9') THEN
           PROCNUM:=PROCNUM*10 + ORD(CH) - ORD('0');
         IF (PROCNUM<1) OR (PROCNUM>PROCS[0]) THEN
           BEGIN
             WRITELN(CR,'I didn''t say you had THAT procedure!');
             PROMPT;
           END
         ELSE IF NOT LEXCHECK THEN
           BEGIN
             PAGE(OUTPUT);
             WRITELN('dis-assembling procedure',PROCNUM:3,CR);
             PROCEJUR;
             PROMPT;
             CH:=' ';
           END
         ELSE
           BEGIN
             DATAPROC:=PROCNUM;
             DATASEG:=SEGNUM;
             DATASEGINFO;
             DATASEGSIZE:=DTSGSZ;
             NEW(DSSTART);
             FOR I:=1 TO ((DATASEGSIZE+19) DIV 20) DO NEW(DSSPACE);
             FILLCHAR(DSSTART^,DATASEGSIZE*2,0);
             FOR PROCNUM:=1 TO PROCS[0] DO
               BEGIN
                 PROCEJUR;
                 PROCLEX[PROCNUM]:=LEXLEVEL;
               END;
             CH:=CHR(7);
           END;
       END;
   UNTIL (CH='Q') OR (CH=CHR(7));
 END;

 PROCEDURE SEGMTGUIDE;
 VAR I,J:INTEGER;
 BEGIN
   REPEAT
     PAGE(OUTPUT);
     WRITELN('Segment guide:  #(of segment),Q(uit)');
     WRITELN(CR,CR,'you have these segments:');
     FOR I:=0 TO 15 DO
       BEGIN
         WRITE(I:4,'      ');
         FOR J:=1 TO 8 DO WRITE(CHR(SEGDIREC[63 + I*8 + J]));
         WRITELN;
       END;
     WRITE(CR,'which segment to look at ');
     IF LEXCHECK THEN
       WRITE('to decide on DATA SEGMENT?')
     ELSE
       WRITE('for possible DIS-ASSEMBLY?');
     READ(CH);
     IF CH<>'Q' THEN
       BEGIN
         SEGNUM:=0;
         IF (CH>='0') AND (CH<='9') THEN SEGNUM:=ORD(CH)-ORD('0');
         READ(CH);
         IF (CH>='0') AND (CH<='9') THEN
           SEGNUM:=SEGNUM*10 + ORD(CH) - ORD('0');
         IF (SEGDIREC[4*SEGNUM] + SEGDIREC[4*SEGNUM + 1]=0) OR (SEGNUM>15) THEN
           BEGIN
             WRITELN(CR,'I didn''t say you had THAT segment!');
             READ(KEYBOARD,CH);
           END
         ELSE
           BEGIN
             PROCGUIDE;
             IF CH<>CHR(7) THEN CH:='A';
           END;
       END;
   UNTIL (CH='Q') OR (CH=CHR(7));
 END;

 PROCEDURE LEXGUIDE;
 BEGIN
   LEXCHECK:=TRUE;
   DATASEG:=-1;
   REPEAT
     SEGMTGUIDE;
     IF CH='Q' THEN
       BEGIN
         PAGE(OUTPUT);
         GOTOXY(0,10);
         WRITELN('have you changed your mind about data segment watching?');
         READ(KEYBOARD,CH);
         IF CH='Y' THEN DATAWATCH:=FALSE;
       END;
   UNTIL (CH=CHR(7)) OR (NOT DATAWATCH);
   IF DATAWATCH THEN
     FOR SEGNUM:=0 TO 15 DO
       IF SEGDIREC[4*SEGNUM] + SEGDIREC[4*SEGNUM + 1]<>0 THEN
         BEGIN
           SEGMINT; {Sets up appropiate segment}
           PROCNUM:=1;
           PROCEJUR; {Sets up procedure to determine segment's lexlevel}
           SEGLEX[SEGNUM]:=LEXLEVEL;
         END
       ELSE SEGLEX[SEGNUM]:=100;
   PAGE(OUTPUT);
   LEXCHECK:=FALSE;
 END;

 BEGIN (* SEGMENT DISASSEMBLE *)
   PAGE(OUTPUT);
   GOTOXY(0,10);
   WRITE('          Do you wish to keep track of references',CR,
           '         to a particular procedure''s data segment?');
   READ(KEYBOARD,CH);
   DATAWATCH:=(CH='Y');
   IF DATAWATCH THEN LEXGUIDE ELSE LEXCHECK:=FALSE;
   PAGE(OUTPUT);
   GOTOXY(0,10);
   WRITE('Do you wish control over dis-assembly?');
   READ(KEYBOARD,CH);
   CONTROL:=(CH='Y');
   IF CONTROL THEN
     BEGIN
       PAGE(OUTPUT);
       GOTOXY(0,7);
       WRITE(CHR(7));
       WRITE('***  WARNING  - -  STATISTICS ARE GATHERED ON DIS-ASSEMBLED');
       WRITELN(' PROCEDURES ONLY  ***');
       IF DATAWATCH THEN WRITELN(CR,CR,'              ',
                          '***   THIS INCLUDES DATA SEGMENT WATCHING   ***');
       READ(KEYBOARD,CH);
       SEGMTGUIDE;
     END
   ELSE
     BEGIN
       IF NOT CONSOLE THEN WRITE(CHR(12),CR);
       FOR SEGNUM:=0 TO 15 DO
         BEGIN
           IF NOT DISPLAY THEN WRITE(CR,'(',SEGNUM:2,')');
           IF SEGDIREC[4*SEGNUM] + SEGDIREC[4*SEGNUM + 1]<>0 THEN SEGMINT;
         END;
       PROMPT;
     END;
 END;
 (* $I DISASM2.TEXT*)

                         {start of DISASM2.TEXT}
         {Copyright (c) Regents of University of California at San Diego}

 SEGMENT PROCEDURE GATHER;
 VAR   FILENAME:STRING;

 PROCEDURE WRITEHDR(VAR H:INTERACTIVE;HEADER:INTEGER);
 BEGIN
   CASE HEADER OF
     1: WRITELN(H,'         Parameter one');
     2: WRITELN(H,'Bits used    Total    Percentage');
     3: WRITELN(H,'         Parameter one           Parameter two         ');
     4: WRITELN(H,'Bits used    Total    Percentage    Total    Percentage');
     5: WRITELN(H,'         Parameter one           Parameter two',
                                                '           Case table size');
     6: WRITELN(H,'Bits used    Total    Percentage    Total    Percentage',
                                                   '    Total    Percentage');
     7: WRITELN(H,'Flavor      Total    Percentage     Flavor',
                                                 '      Total    Percentage');
     8: WRITELN(H,'   #   Total    Pct   #   Total    Pct   #   Total',
                                                 '    Pct   #   Total    Pct')
   END;
 END;

 PROCEDURE JUMPSTUFF;
 VAR   I:INTEGER;
 BEGIN
   WRITELN(LISTFILE,CR,'Jump statistics on the',JUMPTOTAL:5,' Total jumps');
   IF JUMPTOTAL>0 THEN
     BEGIN
       WRITELN(LISTFILE,CR,
                 '                Positive jumps         Negative jumps');
       WRITEHDR(LISTFILE,4);
       WITH JUMPSTATS DO
         FOR I:=0 TO 15 DO
           WRITELN(LISTFILE,I:5,POS[I]:13,POS[I]/JUMPTOTAL*100:14:2,
                          NEG[I]:9,NEG[I]/JUMPTOTAL*100:14:2);
     END
   ELSE WRITELN(LISTFILE,CR,'Sorry no jumps today!');
 END;

 PROCEDURE PROCSTUFF;
 VAR   I,J:INTEGER;
 BEGIN
   WRITELN(LISTFILE,CR,'Procedure call statistics');
   FOR I:=0 TO 15 DO
     IF PROCCALL[I]<>NIL THEN
       FOR J:=1 TO MAXPROCNUM DO
         IF PROCCALL[I]^[J]>0 THEN
           WRITELN(LISTFILE,'  Segment:',I:4,'  Procedure:',J:4,
                                           '  Calls:',PROCCALL[I]^[J]:4);
 END;

 PROCEDURE SHORTSTUFF;
 VAR  I:INTEGER;

 PROCEDURE SHORT1(VAR H:INTERACTIVE);
 BEGIN
   PCTMAX:=ROUND(SLDC/MAXOP*20);
   WRITE(H,CR,'SLDC   OPCODE: 0..127   TOTAL:',
              SLDC:8,SLDC/OPTOTAL*100:16:2,' % ');
   FOR I:=1 TO PCTMAX DO WRITE(H,'*');
   IF SLDC<>0 THEN
     BEGIN
       WRITELN(H,CR); WRITEHDR(H,8);
       FOR OP:=0 TO 31 DO
         WRITELN(H,OP:4,':',OPCODE[OP]^.TOTAL0:7,OPCODE[OP]^.TOTAL0/SLDC*100:7:2,
          OP+32:4,':',OPCODE[OP+32]^.TOTAL0:7,OPCODE[OP+32]^.TOTAL0/SLDC*100:7:2,
          OP+64:4,':',OPCODE[OP+64]^.TOTAL0:7,OPCODE[OP+64]^.TOTAL0/SLDC*100:7:2,
          OP+96:4,':',OPCODE[OP+96]^.TOTAL0:7,OPCODE[OP+96]^.TOTAL0/SLDC*100:7:2);
     END;
   PCTMAX:=ROUND(SLDL/MAXOP*20);
   WRITE(H,CR,CR,'SLDL  OPCODE: 216..231  TOTAL:',
                  SLDL:8,SLDL/OPTOTAL*100:16:2,' % ');
   FOR I:=1 TO PCTMAX DO WRITE(H,'*');
   IF SLDL<>0 THEN
     BEGIN
       WRITELN(H,CR); WRITEHDR(H,8);
       FOR OP:=216 TO 219 DO
         WRITELN(H,OP:4,':',OPCODE[OP]^.TOTAL0:7,OPCODE[OP]^.TOTAL0/SLDL*100:7:2,
          OP+4:4,':',OPCODE[OP+4]^.TOTAL0:7,OPCODE[OP+4]^.TOTAL0/SLDL*100:7:2,
          OP+8:4,':',OPCODE[OP+8]^.TOTAL0:7,OPCODE[OP+8]^.TOTAL0/SLDL*100:7:2,
          OP+12:4,':',OPCODE[OP+12]^.TOTAL0:7,OPCODE[OP+12]^.TOTAL0/SLDL*100:7:2);
     END;
 END;

 PROCEDURE SHORT2(VAR H:INTERACTIVE);
 BEGIN
   PCTMAX:=ROUND(SLDO/MAXOP*20);
   WRITE(H,CR,CR,'SLDO  OPCODE: 232..247  TOTAL:',
                  SLDO:8,SLDO/OPTOTAL*100:16:2,' % ');
   FOR I:=1 TO PCTMAX DO WRITE(H,'*');
   IF SLDO<>0 THEN
     BEGIN
       WRITELN(H,CR); WRITEHDR(H,8);
       FOR OP:=232 TO 235 DO
         WRITELN(H,OP:4,':',OPCODE[OP]^.TOTAL0:7,OPCODE[OP]^.TOTAL0/SLDO*100:7:2,
            OP+4:4,':',OPCODE[OP+4]^.TOTAL0:7,OPCODE[OP+4]^.TOTAL0/SLDO*100:7:2,
            OP+8:4,':',OPCODE[OP+8]^.TOTAL0:7,OPCODE[OP+8]^.TOTAL0/SLDO*100:7:2,
            OP+12:4,':',OPCODE[OP+12]^.TOTAL0:7,OPCODE[OP+12]^.TOTAL0/SLDO*100:7:2);
     END;
   PCTMAX:=ROUND(SIND/MAXOP*20);
   WRITE(H,CR,CR,'SIND  OPCODE: 248..255  TOTAL:',
                  SIND:8,SIND/OPTOTAL*100:16:2,' % ');
   FOR I:=1 TO PCTMAX DO WRITE(H,'*');
   IF SIND<>0 THEN
     BEGIN
       WRITELN(H,CR); WRITEHDR(H,8);
       FOR OP:=248 TO 249 DO
         WRITELN(H,OP:4,':',OPCODE[OP]^.TOTAL0:7,OPCODE[OP]^.TOTAL0/SIND*100:7:2,
              OP+2:4,':',OPCODE[OP+2]^.TOTAL0:7,OPCODE[OP+2]^.TOTAL0/SIND*100:7:2,
              OP+4:4,':',OPCODE[OP+4]^.TOTAL0:7,OPCODE[OP+4]^.TOTAL0/SIND*100:7:2,
              OP+6:4,':',OPCODE[OP+6]^.TOTAL0:7,OPCODE[OP+6]^.TOTAL0/SIND*100:7:2);
     END;
   WRITELN(H);
 END;

 BEGIN(* SHORTSTUFF *)
   SHORT1(LISTFILE);
   SHORT2(LISTFILE);
 END;

 PROCEDURE SHORTST;
 VAR  I:INTEGER;
 BEGIN
   INUM:=OPCODE[OP]^.TOTAL0;
   PCTMAX:=ROUND(INUM/MAXOP*20);
   WRITE(LISTFILE,INUM:8,INUM/OPTOTAL*100:16:2,' % ');
   FOR I:=1 TO PCTMAX DO WRITE('*');
   WRITELN(LISTFILE);
 END;

 PROCEDURE ONEST;
 VAR   I:INTEGER;
 BEGIN
   WITH OPCODE[OP]^ DO
     BEGIN
       INUM:=TOTAL1;
       PCTMAX:=ROUND(INUM/MAXOP*20);
       WRITE(LISTFILE,INUM:8,INUM/OPTOTAL*100:16:2,' % ');
       IF TOTAL1<>0 THEN
         BEGIN
           FOR I:=1 TO PCTMAX DO WRITE(LISTFILE,'*');
           WRITELN(LISTFILE,CR);
           WRITEHDR(LISTFILE,1); WRITELN(LISTFILE);
           WRITEHDR(LISTFILE,2);
           FOR I:=0 TO 7 DO
            WRITELN(LISTFILE,I:5,BYTEONE1[I]:13,BYTEONE1[I]/TOTAL1*100:14:2);
         END
       ELSE WRITELN(LISTFILE);
     END;
   END;

 PROCEDURE TWOST;
 VAR   I:INTEGER;
 BEGIN
   WITH OPCODE[OP]^ DO
     BEGIN
       PCTMAX:=ROUND(TOTAL2/MAXOP*20);
       WRITE(LISTFILE,TOTAL2:8,TOTAL2/OPTOTAL*100:16:2,' % ');
       FOR I:=1 TO PCTMAX DO WRITE(LISTFILE,'*');
       WRITELN(LISTFILE,CR); WRITEHDR(LISTFILE,3);
       WRITELN(LISTFILE); WRITEHDR(LISTFILE,4);
       IF TOTAL2=0 THEN
         FOR I:=0 TO 7 DO
           WRITELN(LISTFILE,I:5,BYTEONE2[I]:13,0.0:14:2,BYTETWO2[I]:9,0.0:14:2)
       ELSE
         FOR I:=0 TO 7 DO
           WRITELN(LISTFILE,I:5,BYTEONE2[I]:13,BYTEONE2[I]/TOTAL2*100:14:2,
                         BYTETWO2[I]:9,BYTETWO2[I]/TOTAL2*100:14:2);
       IF OP=205 THEN
         BEGIN
           WRITELN(LISTFILE); WRITEHDR(LISTFILE,7);
           IF TOTAL2=0 THEN
             FOR I:=2 TO 15 DO
                WRITELN(LISTFILE,NAMES[56+I],FLAVOR2[I]:9,0.0:14:2,'     ',
                          NAMES[56+I+14],FLAVOR2[I+14]:9,0.0:14:2)
           ELSE
             FOR I:=2 TO 15 DO
               WRITELN(LISTFILE,NAMES[56+I],FLAVOR2[I]:9,
                         FLAVOR2[I]/TOTAL2*100:14:2,'     ',
                         NAMES[56+I+14],FLAVOR2[I+14]:9,
                         FLAVOR2[I+14]/TOTAL2*100:14:2);
         END;
     END;
 END;

 PROCEDURE WORDST;
 VAR   I:INTEGER;
 BEGIN
   WITH OPCODE[OP]^ DO
     BEGIN
       INUM:=TOTAL3;
       PCTMAX:=ROUND(INUM/MAXOP*20);
       WRITE(LISTFILE,INUM:8,INUM/OPTOTAL*100:16:2,' % ');
       IF TOTAL3<>0 THEN
         BEGIN
           FOR I:=1 TO PCTMAX DO WRITE(LISTFILE,'*');
           WRITELN(LISTFILE,CR); WRITEHDR(LISTFILE,1);
           WRITELN(LISTFILE); WRITEHDR(LISTFILE,2);
           FOR I:=0 TO 15 DO
             WRITELN(LISTFILE,I:5,PARMONE3[I]:13,PARMONE3[I]/TOTAL3*100:14:2);
         END
       ELSE WRITELN(LISTFILE);
     END;
 END;

 PROCEDURE LOPTST;
 VAR   I:INTEGER;
 BEGIN
   WITH OPCODE[OP]^ DO
     BEGIN
       INUM:=TOTAL4;
       PCTMAX:=ROUND(INUM/MAXOP*20);
       WRITE(LISTFILE,INUM:8,INUM/OPTOTAL*100:16:2,' % ');
       IF TOTAL4<>0 THEN
         BEGIN
           FOR I:=1 TO PCTMAX DO WRITE(LISTFILE,'*');
           WRITELN(LISTFILE,CR); WRITEHDR(LISTFILE,3);
           WRITELN(LISTFILE); WRITEHDR(LISTFILE,4);
           FOR I:=0 TO 7 DO
             WRITELN(LISTFILE,I:5,BYTEONE4[I]:13,BYTEONE4[I]/TOTAL4*100:14:2,
               PARMTWO4[I]:9,PARMTWO4[I]/TOTAL4*100:14:2);
           FOR I:=8 TO 15 DO
             WRITELN(LISTFILE,I:5,PARMTWO4[I]:36,PARMTWO4[I]/TOTAL4*100:14:2);
         END
       ELSE WRITELN(LISTFILE);
     END;
 END;

 PROCEDURE WORDSST;
 VAR   I:INTEGER;
 BEGIN
   WITH OPCODE[OP]^ DO
     BEGIN
       INUM:=TOTAL5;
       PCTMAX:=ROUND(INUM/MAXOP*20);
       WRITE(LISTFILE,INUM:8,INUM/OPTOTAL*100:16:2,' % ');
       IF TOTAL5<>0 THEN
         BEGIN
           FOR I:=1 TO PCTMAX DO WRITE(LISTFILE,'*');
           WRITELN(LISTFILE,CR); WRITEHDR(LISTFILE,5);
           WRITELN(LISTFILE); WRITEHDR(LISTFILE,6);
           FOR I:=0 TO 15 DO
             WRITELN(LISTFILE,I:5,PARMONE5[I]:13,PARMONE5[I]/TOTAL5*100:14:2,
               PARMTWO5[I]:9,PARMTWO5[I]/TOTAL5*100:14:2,
               PARMTHREE5[I]:9,PARMTHREE5[I]/TOTAL5*100:14:2);
         END
       ELSE WRITELN(LISTFILE);
     END;
 END;

 PROCEDURE CMPRSSST;
 VAR   I:INTEGER;
 BEGIN
   WITH OPCODE[OP]^ DO
     BEGIN
       PCTMAX:=ROUND(TOTAL6/MAXOP*20);
       WRITE(LISTFILE,TOTAL6:8,TOTAL6/OPTOTAL*100:16:2,' % ');
       FOR I:=1 TO PCTMAX DO WRITE(LISTFILE,'*');
       WRITELN(LISTFILE,CR); WRITEHDR(LISTFILE,7);
       IF TOTAL6=0 THEN
         BEGIN
           FOR I:=0 TO 19 DO
             WRITELN(LISTFILE,NAMES[86+I],FLAVOR6[I]:9,0.0:14:2,'     ',
                     NAMES[106+I],FLAVOR6[I+20]:9,0.0:14:2);
           WRITELN(LISTFILE,NAMES[126]:44,FLAVOR6[40]:9,0.0:14:2);
         END
       ELSE
         BEGIN
           FOR I:=0 TO 19 DO
             WRITELN(LISTFILE,NAMES[86+I],FLAVOR6[I]:9,
               FLAVOR6[I]/TOTAL6*100:14:2,
               NAMES[106+I]:13,FLAVOR6[I+20]:9,FLAVOR6[I+20]/TOTAL6*100:14:2);
           WRITELN(LISTFILE,NAMES[126]:44,
               FLAVOR6[40]:9,FLAVOR6[40]/TOTAL6*100:14:2);
         END;
     END;
 END;

 PROCEDURE CMPRSS2ST;
 VAR   I:INTEGER;
 BEGIN
   WITH OPCODE[OP]^ DO
   BEGIN
     INUM:=TOTAL7;
     PCTMAX:=ROUND(INUM/MAXOP*20);
     WRITE(LISTFILE,INUM:8,INUM/OPTOTAL*100:16:2,' % ');
     FOR I:=1 TO PCTMAX DO WRITE(LISTFILE,'*');
     WRITELN(LISTFILE,CR); WRITEHDR(LISTFILE,7);
     FOR I:=1 TO 6 DO
       BEGIN
         IF INUM<>0 THEN
           WRITE(LISTFILE,NAMES[51+I],FLAVOR7[I]:9,FLAVOR7[I]/INUM*100:14:2,'     ')
         ELSE
           WRITE(LISTFILE,NAMES[51+I],FLAVOR7[I]:9,0.0:14:2,'     ');
         IF (I MOD 2=0) THEN WRITELN(LISTFILE);
       END;
   END;
 END;

 PROCEDURE GINIT;
 BEGIN
   MAXOP:=0;
   FOR OP:=128 TO 215 DO
     WITH OPCODE[OP]^ DO
       CASE RECTYPES[OP] OF
             ONE,CHRS,BLK:IF (TOTAL1>MAXOP) THEN MAXOP:=TOTAL1;
                      TWO:IF (TOTAL2>MAXOP) THEN MAXOP:=TOTAL2;
                 WORD,OPT:IF (TOTAL3>MAXOP) THEN MAXOP:=TOTAL3;
                     LOPT:IF (TOTAL4>MAXOP) THEN MAXOP:=TOTAL4;
                    WORDS:IF (TOTAL5>MAXOP) THEN MAXOP:=TOTAL5;
                   CMPRSS:IF (TOTAL6>MAXOP) THEN MAXOP:=TOTAL6;
                  CMPRSS2:IF (TOTAL7>MAXOP) THEN MAXOP:=TOTAL7
        END;
 END;

 BEGIN (* SEGMENT PROCEDURE GATHER *)
   GINIT;
   PAGE(OUTPUT);
   GOTOXY(0,10);
   WRITE(CHR(7),'Output file for opcode statistics (<CR> for none): ');
   READLN(FILENAME);
   DISPLAY:=(FILENAME<>'');
   CONSOLE:=(FILENAME='CONSOLE:') OR (FILENAME='#1:');
   IF DISPLAY THEN
     BEGIN
       IF (FILENAME<>LASTFILENAME) THEN
         BEGIN
           CLOSE(LISTFILE,LOCK);
           REWRITE(LISTFILE,FILENAME);
           LASTFILENAME:=FILENAME;
         END;
       PAGE(OUTPUT);
       PROCSTUFF;
       JUMPSTUFF;
       SHORTSTUFF;
       FOR OP:=128 TO 215 DO
         BEGIN
           WRITE(LISTFILE,CR,NAMES[OP],'  Opcode:',OP:4,'   Total:');
           CASE RECTYPES[OP] OF
                       SHORT:SHORTST;
                    OPT,WORD:WORDST;
                ONE,CHRS,BLK:ONEST;
                         TWO:TWOST;
                        LOPT:LOPTST;
                       WORDS:WORDSST;
                      CMPRSS:CMPRSSST;
                     CMPRSS2:CMPRSS2ST
             END;
         END;
       WRITELN(CR,CR,CR,OPTOTAL:20,'   Total operators');
     END;
 END;

 SEGMENT PROCEDURE DATACOUNT;
 TYPE  ACTPTR=^ACTREC;
       ACTREC=RECORD
         OFFSET,TOTAL:INTEGER;
         LES,GTR:ACTPTR
       END;
 VAR   TOTAL:INTEGER;
       HEAP:^INTEGER;
       TREETRUNK,ENTRY:ACTPTR;
       FILENAME:STRING;

 PROCEDURE SETORDER;
 VAR INDEX:INTEGER;

 PROCEDURE DATASET(TREEMARK:ACTPTR);
 BEGIN
   {$R-}
   IF DSSTART^[INDEX]<TREEMARK^.TOTAL THEN
     IF TREEMARK^.LES<>NIL THEN
       DATASET(TREEMARK^.LES)
     ELSE
       BEGIN
         NEW(ENTRY);
         ENTRY^.OFFSET:=INDEX;
         ENTRY^.TOTAL:=DSSTART^[INDEX];
         ENTRY^.LES:=NIL;
         ENTRY^.GTR:=NIL;
         TREEMARK^.LES:=ENTRY;
       END
   ELSE IF TREEMARK^.GTR<>NIL THEN
       DATASET(TREEMARK^.GTR)
     ELSE
       BEGIN
         NEW(ENTRY);
         ENTRY^.OFFSET:=INDEX;
         ENTRY^.TOTAL:=DSSTART^[INDEX];
         ENTRY^.LES:=NIL;
         ENTRY^.GTR:=NIL;
         TREEMARK^.GTR:=ENTRY;
       END;
   {$R+}
 END;

 BEGIN
   NEW(TREETRUNK);
   TREETRUNK^.TOTAL:=0;
   TREETRUNK^.LES:=NIL;
   TREETRUNK^.GTR:=NIL;
   DATAREF:=0; INDEX:=0;
   REPEAT
     {$R-}
     INDEX:=INDEX + SCAN((DATASEGSIZE-INDEX)*2,<>CHR(0),DSSTART^[INDEX]) DIV 2;
     IF DSSTART^[INDEX]>0 THEN
       BEGIN
         DATASET(TREETRUNK);
         DATAREF:=DATAREF + DSSTART^[INDEX];
         DSSTART^[INDEX]:=0;
       END;
     {$R+}
   UNTIL INDEX>=DATASEGSIZE;
 END;

 PROCEDURE DATAHEADER(VAR H2:INTERACTIVE);
 VAR  I:INTEGER;
 BEGIN
   WRITELN(H2,CR,CR,'Data Segment size:',DATASEGSIZE:6,'      Data references:',
                       DATAREF:6,'      Lex level',PROCLEX[DATAPROC]:6);
   WRITE(H2,CR,CR,'For segment ');
   FOR I:=1 TO 8 DO WRITE(H2,CHR(SEGDIREC[63 + DATASEG*8 +I]));
   WRITELN(H2,' Procedure #',DATAPROC:3);
   WRITELN(H2,'Offset(word)  Total      %');
 END;

 PROCEDURE PRINTDATA(TREE:ACTPTR);
 BEGIN
   IF TREE^.GTR<>NIL THEN PRINTDATA(TREE^.GTR);
   TOTAL:=TREE^.TOTAL;
   IF DISPLAY THEN WRITELN(LISTFILE,
             TREE^.OFFSET:9,TOTAL:11,TOTAL/DATAREF*100:9:2);
   IF TREE^.LES<>NIL THEN PRINTDATA(TREE^.LES);
 END;

 BEGIN (* DATACOUNT *);
   MARK(HEAP);
   PAGE(OUTPUT);
   GOTOXY(0,10);
   WRITE(CHR(7),'Output file for data segment statistics(<CR> for none): ');
   READLN(FILENAME);
   DISPLAY:=(FILENAME<>'');
   CONSOLE:=(FILENAME='CONSOLE:') OR (FILENAME='#1:');
   IF DISPLAY AND (FILENAME<>LASTFILENAME) THEN
     BEGIN
       CLOSE(LISTFILE,LOCK);
       REWRITE(LISTFILE,FILENAME);
       LASTFILENAME:=FILENAME;
     END;
   PAGE(OUTPUT);
   SETORDER;
   IF DISPLAY THEN DATAHEADER(LISTFILE);
   IF DATAREF>0 THEN
     PRINTDATA(TREETRUNK^.GTR)
   ELSE
     BEGIN
       IF DISPLAY THEN WRITELN(LISTFILE,CR,CR,
                 'sorry but there were no accesses',
                 ' to this data segment from dis-assembled procedures');
     END;
   PROMPT;
   RELEASE(HEAP);
 END;

 PROCEDURE PROMPT;
 VAR  CH:CHAR;
 BEGIN
   WRITE(CHR(7),CR,CR,'press spacebar to continue...');
   REPEAT  READ(CH)  UNTIL CH=' ';
   WRITELN;
 END;


 BEGIN(*MAIN STUFF*)
   INIT;
   DISASSEMBLE;
   IF DATAWATCH THEN DATACOUNT;
   GATHER;
   IF DISPLAY AND NOT CONSOLE THEN CLOSE(LISTFILE,LOCK);
 END.
	
{ +------------------------------------------------------------------+
  |                                                                  |
		|                     F     I     N     I     S                    |
		|                                                                  |
		+------------------------------------------------------------------+ }
